home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-15
/
memtest2.zip
/
MEMTEST2.PRG
< prev
Wrap
Text File
|
1993-01-04
|
16KB
|
679 lines
*:*********************************************************************
*:
*: Program: MEMTEST2.PRG
*:
*: System: FoxBASE+ MEMORY VARIABLE MEMORY HANDLING
*: Author: Pat Adams
*: Copyright (c) 1989, DB Unlimited
*: Last modified: 02/03/89 17:32
*:
*: Procs & Fncts: REGULAR1
*: : HIDE1
*: : PUBLIC1
*: : MIXUP1
*: : PPASS1
*: : PASMIX1
*: : REGULAR2
*: : HIDE2
*: : PUBLIC2
*: : PUBLIC3
*: : MIXUP2
*: : MIXUP3
*: : PPASS2
*: : PASMIX2
*:
*: Calls: REGULAR1 (procedure in MEMTEST2.PRG)
*: : HIDE1 (procedure in MEMTEST2.PRG)
*: : PUBLIC1 (procedure in MEMTEST2.PRG)
*: : MIXUP1 (procedure in MEMTEST2.PRG)
*: : PPASS1 (procedure in MEMTEST2.PRG)
*: : PASMIX1 (procedure in MEMTEST2.PRG)
*:
*: Documented 02/03/89 at 17:48 SNAP! version 3.12e
*:*********************************************************************
* MEMTEST.PRG
*
* This program tests handling of memory variables,
* arrays, parameter passing, and the RELEASE command.
*
* Author: Pat Adams, DB Unlimited 1/20/89
*
* * * * * * * * * *
*
SET PROC TO memtest2
CLEAR MEMORY
SET TALK OFF
SET BELL OFF
SET COLOR TO GR+/N, W+/B
SET STATUS ON
* ======================
* $ Do routine to show activity
* associated with the three
* categories of memory variables
* ======================
DO regular1
CLEAR MEMORY
DO hide1
DO public1
DO mixup1
DO ppass1
DO pasmix1
CLOSE PROC
RETURN
*!*******************************************
*!
*! Procedure: REGULAR1
*!
*! Called by: MEMTEST2.PRG
*!
*! Calls: REGULAR2 (procedure in MEMTEST2.PRG)
*!
*!*******************************************
PROCEDURE regular1
*********************************
*& Test handling of standard memory variables
*
STORE "Standard memvar initalized at level 1" TO reg1a
STORE CTOD("01/01/01") TO reg1b
STORE 11111.11 TO reg1c
SET COLOR TO GR+/N BR+/B
CLEAR
?
? " Standard memory variables have been initalized at level 1 "
? " The REG1D logical memvar was declared but no input stored."
? " The logical memory variable is not acknowledged."
?
WAIT
?
DISPLAY MEMO
WAIT
DO regular2
SET COLOR TO GR+/N BR+/B
CLEAR
? " Now back at level 1"
? " Notice that, since the PRIVATE statement was not"
? " used specifically in establishing the memvars of the"
? " same name at the two different levels, the memory"
? " variables at level 1 and level 2, which all had the"
? " same name, were not differentiated and the memvars"
? " at level 1 were changed by the level 2 input."
? " The input for REG1D is now not available and REG1D is"
? " still not acknowledged as initalized."
?
WAIT
?
CLEAR TYPEAHEAD
DISPLAY MEMO
WAIT
RETURN
* END Procedure Regular1
*!*********************************************
*!
*! Procedure: REGULAR2
*!
*! Called by: REGULAR1 (procedure in MEMTEST2.PRG)
*!
*!********************************************
PROCEDURE regular2
********************************
*& Test handling of standard memvars at level 2
*
SET COLOR TO BR+/N, GR+/B
CLEAR
STORE "STOREd at level 2" TO reg1a
STORE CTOD("02/02/02") TO reg1b
STORE 22222.22 TO reg1c
STORE .T. TO reg1d
?
? " Now at level 2. Regular memory variables have been initalized at"
? " level 2 with the same name as those initalized at level 1."
? " Note that the memory variables originally acknowledged at level 1"
? " are, here at level 2, incorrectly evaluated as level 1 memvars and"
? " information STOREd at this level has changed those memory variables."
? " Because a logical .T. was stored to REG1D at level two, it is"
? " acknowledged here at level 2."
?
WAIT
?
CLEAR TYPEAHEAD
DISPLAY MEMO
WAIT
RETURN
* END Procedure Regular2
*!*************************************************
*!
*! Procedure: HIDE1
*!
*! Called by: MEMTEST2.PRG
*!
*! Calls: HIDE2 (procedure in MEMTEST2.PRG)
*!
*!**************************************************
PROCEDURE hide1
*********************************
*& Testing PRIVATE hidden memory variables
*
PRIVATE priv1a, priv1b, priv1c, priv1d
STORE "PRIV initalized at level 1" TO priv1a
STORE 11111.11 TO priv1b
STORE CTOD("01/01/01") TO priv1c
SET COLOR TO W+/R, GR+/B
CLEAR
?
? " PRIVATE (hidden) memvars have been initalized at level 1"
? " Notice that although a PRIV1D memvar was declared, info"
? " was not stored to it, and it [improperly] does not appear"
? " in the memory variable list."
?
WAIT
?
DISPLAY MEMO
WAIT
DO hide2
SET COLOR TO W+/R, GR+/B
CLEAR
?
? " Now back at level 1. Note the proper differential was"
? " made at each level and the PRIVATE hidden memvars declared"
? " at level one still have the original information. However,"
? " the logical memvar PRIV1D is still not acknowledged at level 1."
?
WAIT
?
DISPLAY MEMO
WAIT
RETURN
* END Procedure Hide1
*!***************************************************
*!
*! Procedure: HIDE2
*!
*! Called by: HIDE1 (procedure in MEMTEST2.PRG)
*!
*!****************************************************
PROCEDURE hide2
******************************
*& Test PRIVATE (hidden) memvars at level 2
*
*
PRIVATE priv1a, priv1b, priv1c, priv1d
STORE "PRIV initalized at level 2" TO priv1a
STORE 22222.22 TO priv1b
STORE CTOD("02/02/02") TO priv1c
STORE .T. TO priv1d
SET COLOR TO W+/B, GR+/R
CLEAR
?
?
? " PRIVATE (hidden) memvars have been initalized at level 2 with the"
? " same name as those at level 1."
?
WAIT
?
DISPLAY MEMO
WAIT
RETURN
* END Procedure Hide2
*!**********************************************
*!
*! Procedure: PUBLIC1
*!
*! Called by: MEMTEST2.PRG
*!
*! Calls: PUBLIC2 (procedure in MEMTEST2.PRG)
*! : PUBLIC3 (procedure in MEMTEST2.PRG)
*!
*!***********************************************
PROCEDURE public1
****************************
*& Test PUBLIC memvars
*
*
CLEAR MEMORY
SET COLOR TO B/G, G+/W
CLEAR
PUBLIC pub1a, pub1b, pub1c, pub1d
STORE "Public declared at level 1" TO pub1a
STORE 11111.11 TO pub1b
STORE CTOD("01/01/01") TO pub1c
?
? " Public memvars have been declared and initalized at level 1"
? " Logical memvar PUB1D was declared PUBLIC but not initalized."
? " Unlike the way PRIVATE acts, the PUB1D logical memvar is acknowledged."
?
WAIT
?
DISPLAY MEMO
WAIT
DO public2
SET COLOR TO B/G, G+/W
CLEAR
?
? " We have now returned to level 1. Notice that the PUBLIC memory"
? " variables were properly updated by changes made at level 2"
?
WAIT
?
DISP MEMORY
WAIT
CLEAR MEMO
SET COLOR TO B/G, G+/W
PUBLIC pub1a, pub1b, pub1c, pub1d
STORE "Public declared at level 1" TO pub1a
STORE 11111.11 TO pub1b
STORE CTOD("01/01/01") TO pub1c
CLEAR
? " Now we are going to test what happends when PUBLIC memvars of"
? " the same name are declared at both level 1 and level 2"
? " Memvars have been established at level 1, but the PUB1D memvar"
? " has not had input."
?
WAIT
DISPLAY MEMO
?
WAIT
DO public3
SET COLOR TO B/G, G+/W
CLEAR
?
? " We have now returned to level 1. NOTE that although the"
? " PUBLIC memvars were redeclared at level 2, no problems"
? " resulted. Data stored at level 2 is available at level 1."
?
WAIT
?
DISP MEMO
WAIT
RETURN
*!********************************************
*!
*! Procedure: PUBLIC2
*!
*! Called by: PUBLIC1 (procedure in MEMTEST2.PRG)
*!
*!*********************************************
PROCEDURE public2
*****************************
*& Test handling of public memvars at level 2
*
*
STORE "Changed at level 2" TO pub1a
STORE 22222.22 TO pub1b
STORE CTOD("02/02/02") TO pub1c
STORE .T. TO pub1d
SET COLOR TO G+/GR, GR+/N
CLEAR
?
? " Now at level 2. Contents of the public memvars have been changed"
?
WAIT
?
DISPLAY MEMORY
WAIT
RETURN
* END Procedure Public2
*!**********************************************
*!
*! Procedure: PUBLIC3
*!
*! Called by: PUBLIC1 (procedure in MEMTEST2.PRG)
*!
*!***********************************************
PROCEDURE public3
******************************
*& Test duplication of PUBLIC memvars
PUBLIC pub1a, pub1b, pub1c, pub1d
STORE "Public declared at level 2" TO pub1a
STORE 22222.22 TO pub1b
STORE CTOD("02/02/02") TO pub1c
STORE .T. TO pub1d
SET COLOR TO N/BR, B/GR
CLEAR
?
? " Now at level 2. The entire set of memvars has been declared"
? " PUBLIC again, using the same memvar names."
?
WAIT
?
DISPLAY MEMO
WAIT
RETURN
* END Procedure Public3
*!***************************************************
*!
*! Procedure: MIXUP1
*!
*! Called by: MEMTEST2.PRG
*!
*! Calls: MIXUP2 (procedure in MEMTEST2.PRG)
*! : MIXUP3 (procedure in MEMTEST2.PRG)
*!
*!******************************************************
PROCEDURE mixup1
***********************************
*& Mix private and public memvars
*
CLEAR MEMO
SET COLOR TO GR+/N, N/G
CLEAR
?
? " The next lines of code will generate an error message."
? " Please respond with an I for ignore"
?
WAIT
?
PRIVATE mix1
STORE "Level 1 initalization" TO mix1
PUBLIC mix1
STORE "Test PRIV & PUBLIC conflicts at 1" TO mix1
SET COLOR TO GR+/N, N/G
CLEAR
?
? " An attempt has been made to establish a PRIVATE and a PUBLIC"
? " memvar of the same name at level 1. The PRIVATE mix1 memvar"
? " was declared first and takes precedence. Note that PRIVATE "
? " and PUBLIC memvars of the same name are not permitted at "
? " the same level."
?
WAIT
DISP MEMO
WAIT
CLEAR MEMO
PRIVATE mix2
STORE "Level 1 mix & match test" TO mix2
CLEAR
? " This is another mix and match test of PUBLIC and PRIVATE."
? " A PRIVATE memvar named MIX2 has been initalized at level 1."
?
WAIT
?
DISP MEMO
WAIT
DO mixup2
CLEAR
?
? " We have now returned to level 1 with the mixup test."
? " We could not establish both a PRIVATE memvar here and a PUBLIC "
? " memvar of the same name at a lower level. However, FoxBASE+ did"
? " not respond correctly because the character string for the"
? " PRIVATE memvar declared at level 1 now contains the information we"
? " attempted to place in the PUBLIC memvar at the lower level."
? " Take a look at the value of the MIX2 memvar."
?
WAIT
?
DISP MEMO
WAIT
CLEAR MEMO
PUBLIC mix3
CLEAR
STORE "PUB initalized at level 1" TO mix3
?
? " Now we will test the ability to declare a PUBLIC memvar at one level"
? " and then initalize a PRIVATE memvar of the same name at a lower level."
?
WAIT
?
DISPLAY MEMO
WAIT
DO mixup3
CLEAR
?
? " We have now returned to level in the PUBLIC and PRIVATE mix and match"
? " test. In this instance, FoxBASE+ has handled the situation correctly."
?
WAIT
?
DISPLAY MEMO
?
WAIT
* END Procedure Mixup1
*!***************************************************
*!
*! Procedure: MIXUP2
*!
*! Called by: MIXUP1 (procedure in MEMTEST2.PRG)
*!
*!**************************************************
PROCEDURE mixup2
******************************
*& Mix & Match memvar test
*
CLEAR
?
? " The next lines of code will generate an error message."
? " Please input an I for ignore."
?
WAIT
PUBLIC mix2
CLEAR
STORE "Public memvar initalized at level 2" TO mix2
CLEAR
?
? " Again, it was not possible to create a PUBLIC memvar with the same"
? " name as a PRIVATE memvar declared at the higher level."
?
WAIT
?
DISP MEMO
WAIT
RETURN
* END Procedure Mixup2
*!**********************************************
*!
*! Procedure: MIXUP3
*!
*! Called by: MIXUP1 (procedure in MEMTEST2.PRG)
*!
*!***********************************************
PROCEDURE mixup3
**********************************
*& Test mixing of PUBLIC & Private memvars
*
CLEAR
PRIVATE mix3
STORE "PRIV initalized at level 2" TO mix3
?
? " Now at level 2. FoxBASE+ has permitted us to initalize a PRIVATE"
? " memory variable with the same name as the PUBLIC memvar [MIX3]"
? " declared at the higher level."
?
WAIT
?
DISPLAY MEMO
?
WAIT
RETURN
* END Procedure Mixup3
*!**************************************************
*!
*! Procedure: PPASS1
*!
*! Called by: MEMTEST2.PRG
*!
*! Calls: PPASS2 (procedure in MEMTEST2.PRG)
*!
*!***************************************************
PROCEDURE ppass1
*********************************************
*& Test parameter passing - Level 1
*
CLEAR MEMORY
SET COLOR TO BG+/N, B/W
CLEAR
STORE "Level 1" TO cparam
STORE 11111.11 TO nparam
STORE .F. TO lparam
?
? " We are now at level 1 of the test for passing of parameters."
? " Memory variables have been initalized and will be passed to level 2"
?
WAIT
?
DISPLAY MEMO
WAIT
DO ppass2 WITH cparam, nparam, lparam
CLEAR
?
? " Now back at level 1 of parameter passing test. Note that the"
? " information in the memory variables that were passed down to"
? " level still remain changed by the activity in level 2."
?
WAIT
?
DISPLAY MEMO
?
WAIT
RETURN
* END Procedure PPASS1
*!*********************************************
*!
*! Procedure: PPASS2
*!
*! Called by: PPASS1 (procedure in MEMTEST2.PRG)
*!
*!**********************************************
PROCEDURE ppass2
********************************
*& Test of parameter passing
*
PARAMETERS xchar, xnum, xlogic
CLEAR
? " We are now at level 2 of the parameter passing test. No actions"
? " have yet been taken other than to pass down the parameters."
?
WAIT
?
DISPLAY MEMO
?
WAIT
STORE "Changed at level 2" TO xchar
STORE 22222.22 TO xnum
STORE .T. TO xlogic
CLEAR
?
? " New data has been stored to the passed parameters. Take a look"
? " at the effect on the original memory variables established at level 1."
? " Instead of actually storing the input from level two to the 'passed'"
? " memvars, the original memvars at level 1 have been changed. This is"
? " known as passing by reference."
?
WAIT
>
DISPLAY MEMO
?
WAIT
RETURN
* END Procedure PPASS2
*!*********************************************
*!
*! Procedure: PASMIX1
*!
*! Called by: MEMTEST2.PRG
*!
*! Calls: PASMIX2 (procedure in MEMTEST2.PRG)
*!
*!***********************************************
PROCEDURE pasmix1
*********************************
*& Test passing of parameters and use of PRIVATE at level 2
*
CLEAR MEMORY
PRIVATE cparam, napram, lparam
STORE "Level 1" TO cparam
STORE 11111.11 TO nparam
STORE .F. TO lparam
SET COLOR TO R+/N, W+/R
CLEAR
?
? " Now we will test passing of parameters where the memory variables"
? " passed have first been declared private at level 1."
?
WAIT
?
DISPLAY MEMO
?
WAIT
DO pasmix2 WITH cparam, nparam, lparam
CLEAR
?
? " Now we have returned to level 1. Let's see if the original memvars"
? " have been changed."
?
WAIT
?
DISPLAY MEMO
?
WAIT
RETURN
* END Procedure Pasmix1
*!******************************************
*!
*! Procedure: PASMIX2
*!
*! Called by: PASMIX1 (procedure in MEMTEST2.PRG)
*!
*!*******************************************
PROCEDURE pasmix2
****************************************
PARAMETERS xchar, xnum, xlogic
CLEAR
? " Now at level 2. No action has been taken other than to pass down"
? " the parameters from level 1."
?
WAIT
?
DISPLAY MEMO
?
WAIT
STORE "Changed at level 2" TO xchar
STORE 22222.22 TO xnum
STORE .T. TO xlogic
CLEAR
?
? " Changes have now been made to the memvar/parameters at level 2."
?
WAIT
?
DISPLAY MEMO
?
WAIT
RETURN
* END Procedure Pasmix2